home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / ehelp.el < prev    next >
Lisp/Scheme  |  1993-06-02  |  12KB  |  326 lines
  1. ;;; ehelp.el --- bindings for electric-help mode
  2.  
  3. ;; Copyright (C) 1986 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6. ;; Keywords: help, extensions
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; This package provides a pre-packaged `Electric Help Mode' for
  27. ;; browsing on-line help screens.  There is one entry point,
  28. ;; `with-electric-help'; All you have to give it is a no-argument
  29. ;; function that generates the actual text of the help into the urrent
  30. ;; buffer.
  31.  
  32. ;;; Code:
  33.  
  34. (require 'electric)
  35. (defvar electric-help-map ()
  36.   "Keymap defining commands available in `electric-help-mode'.")
  37.  
  38. (put 'electric-help-undefined 'suppress-keymap t)
  39. (if electric-help-map
  40.     ()
  41.   (let ((map (make-keymap)))
  42.     (fillarray (car (cdr map)) 'electric-help-undefined)
  43.     (define-key map (char-to-string meta-prefix-char) (copy-keymap map))
  44.     (define-key map (char-to-string help-char) 'electric-help-help)
  45.     (define-key map "?" 'electric-help-help)
  46.     (define-key map " " 'scroll-up)
  47.     (define-key map "\^?" 'scroll-down)
  48.     (define-key map "." 'beginning-of-buffer)
  49.     (define-key map "<" 'beginning-of-buffer)
  50.     (define-key map ">" 'end-of-buffer)
  51.     ;(define-key map "\C-g" 'electric-help-exit)
  52.     (define-key map "q" 'electric-help-exit)
  53.     (define-key map "Q" 'electric-help-exit)
  54.     ;;a better key than this?
  55.     (define-key map "r" 'electric-help-retain)
  56.  
  57.     (setq electric-help-map map)))
  58.    
  59. (defun electric-help-mode ()
  60.   "`with-electric-help' temporarily places its buffer in this mode.
  61. \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
  62.   (setq buffer-read-only t)
  63.   (setq mode-name "Help")
  64.   (setq major-mode 'help)
  65.   (setq mode-line-buffer-identification '(" Help:  %b"))
  66.   (use-local-map electric-help-map)
  67.   ;; this is done below in with-electric-help
  68.   ;(run-hooks 'electric-help-mode-hook)
  69.   )
  70.  
  71. (defun with-electric-help (thunk &optional buffer noerase)
  72.   "Arguments are THUNK &optional BUFFER NOERASE.  BUFFER defaults to \"*Help*\"
  73. THUNK is a function of no arguments which is called to initialize
  74. the contents of BUFFER.  BUFFER will be erased before THUNK is called unless
  75. NOERASE is non-nil.  THUNK will be called with `standard-output' bound to
  76. the buffer specified by BUFFER
  77.  
  78. After THUNK has been called, this function \"electrically\" pops up a window
  79. in which BUFFER is displayed and allows the user to scroll through that buffer
  80. in electric-help-mode.
  81. When the user exits (with `electric-help-exit', or otherwise) the help
  82. buffer's window disappears (i.e., we use `save-window-excursion')
  83. BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit"
  84.   (setq buffer (get-buffer-create (or buffer "*Help*")))
  85.   (let ((one (one-window-p t))
  86.     (config (current-window-configuration))
  87.         (bury nil))
  88.     (unwind-protect
  89.          (save-excursion
  90.            (if one (goto-char (window-start (selected-window))))
  91.            (let ((pop-up-windows t))
  92.              (pop-to-buffer buffer))
  93.            (save-excursion
  94.              (set-buffer buffer)
  95.              (electric-help-mode)
  96.              (setq buffer-read-only nil)
  97.              (or noerase (erase-buffer)))
  98.            (let ((standard-output buffer))
  99.              (if (not (funcall thunk))
  100.                  (progn
  101.                    (set-buffer buffer)
  102.                    (set-buffer-modified-p nil)
  103.                    (goto-char (point-min))
  104.                    (if one (shrink-window-if-larger-than-buffer (selected-window))))))
  105.            (set-buffer buffer)
  106.            (run-hooks 'electric-help-mode-hook)
  107.            (if (eq (car-safe (electric-help-command-loop))
  108.                    'retain)
  109.                (setq config (current-window-configuration))
  110.                (setq bury t)))
  111.       (message "")
  112.       (set-buffer buffer)
  113.       (setq buffer-read-only nil)
  114.       (condition-case ()
  115.           (funcall (or default-major-mode 'fundamental-mode))
  116.         (error nil))
  117.       (set-window-configuration config)
  118.       (if bury
  119.           (progn
  120.             ;;>> Perhaps this shouldn't be done.
  121.             ;; so that when we say "Press space to bury" we mean it
  122.             (replace-buffer-in-windows buffer)
  123.             ;; must do this outside of save-window-excursion
  124.             (bury-buffer buffer))))))
  125.  
  126. (defun electric-help-command-loop ()
  127.   (catch 'exit
  128.     (if (pos-visible-in-window-p (point-max))
  129.     (progn (message "<<< Press Space to bury the help buffer >>>")
  130.            (if (equal (setq unread-command-events (list (read-event)))
  131.               '(?\ ))
  132.            (progn (setq unread-command-events nil)
  133.               (throw 'exit t)))))
  134.     (let (up down both neither
  135.       (standard (and (eq (key-binding " ")
  136.                  'scroll-up)
  137.              (eq (key-binding "\^?")
  138.                  'scroll-down)
  139.              (eq (key-binding "Q")
  140.                  'electric-help-exit)
  141.              (eq (key-binding "q")
  142.                  'electric-help-exit))))
  143.       (Electric-command-loop
  144.         'exit
  145.     (function (lambda ()
  146.       (let ((min (pos-visible-in-window-p (point-min)))
  147.         (max (pos-visible-in-window-p (point-max))))
  148.         (cond ((and min max)
  149.            (cond (standard "Press Q to exit ")
  150.              (neither)
  151.              (t (setq neither (substitute-command-keys "Press \\[scroll-up] to exit ")))))
  152.           (min
  153.            (cond (standard "Press SPC to scroll, Q to exit ")
  154.              (up)
  155.              (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll; \\[electric-help-exit] to exit ")))))
  156.           (max
  157.            (cond (standard "Press DEL to scroll back, Q to exit ")
  158.              (down)
  159.              (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[scroll-up] to exit ")))))
  160.           (t
  161.            (cond (standard "Press SPC to scroll, DEL to scroll back, Q to exit ")
  162.              (both)
  163.              (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit ")))))))))
  164.             t))))
  165.  
  166.  
  167.  
  168. ;(defun electric-help-scroll-up (arg)
  169. ;  ">>>Doc"
  170. ;  (interactive "P")
  171. ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
  172. ;      (electric-help-exit)
  173. ;    (scroll-up arg)))
  174.  
  175. (defun electric-help-exit ()
  176.   ">>>Doc"
  177.   (interactive)
  178.   (throw 'exit t))
  179.  
  180. (defun electric-help-retain ()
  181.   "Exit `electric-help', retaining the current window/buffer configuration.
  182. \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
  183. will select it.)"
  184.   (interactive)
  185.   (throw 'exit '(retain)))
  186.  
  187.  
  188. (defun electric-help-undefined ()
  189.   (interactive)
  190.   (error "%s is undefined -- Press %s to exit"
  191.      (mapconcat 'single-key-description (this-command-keys) " ")
  192.      (if (eq (key-binding "Q") 'electric-help-exit)
  193.          "Q"
  194.        (substitute-command-keys "\\[electric-help-exit]"))))
  195.  
  196.  
  197. ;>>> this needs to be hairified (recursive help, anybody?)
  198. (defun electric-help-help ()
  199.   (interactive)
  200.   (if (and (eq (key-binding "Q") 'electric-help-exit)
  201.        (eq (key-binding " ") 'scroll-up)
  202.        (eq (key-binding "\^?") 'scroll-down))
  203.       (message "SPC scrolls forward, DEL scrolls back, Q exits and burys help buffer")
  204.     ;; to give something for user to look at while slow substitute-cmd-keys
  205.     ;;  grinds away
  206.     (message "Help...")
  207.     (message "%s" (substitute-command-keys "\\[scroll-up] scrolls forward, \\[scroll-down] scrolls back, \\[electric-help-exit] exits.")))
  208.   (sit-for 2))
  209.  
  210.  
  211. (defun electric-helpify (fun)
  212.   (let ((name "*Help*"))
  213.     (if (save-window-excursion
  214.       ;; kludge-o-rama
  215.       (let* ((p (symbol-function 'print-help-return-message))
  216.          (b (get-buffer name))
  217.          (m (buffer-modified-p b)))
  218.         (and b (not (get-buffer-window b))
  219.          (setq b nil))
  220.         (unwind-protect
  221.         (progn
  222.           (message "%s..." (capitalize (symbol-name fun)))
  223.           ;; with-output-to-temp-buffer marks the buffer as unmodified.
  224.           ;; kludging excessively and relying on that as some sort
  225.           ;;  of indication leads to the following abomination...
  226.           ;;>> This would be doable without such icky kludges if either
  227.           ;;>> (a) there were a function to read the interactive
  228.           ;;>>     args for a command and return a list of those args.
  229.           ;;>>     (To which one would then just apply the command)
  230.           ;;>>     (The only problem with this is that interactive-p
  231.           ;;>>      would break, but that is such a misfeature in
  232.           ;;>>      any case that I don't care)
  233.           ;;>>     It is easy to do this for emacs-lisp functions;
  234.           ;;>>     the only problem is getting the interactive spec
  235.           ;;>>     for subrs
  236.           ;;>> (b) there were a function which returned a
  237.           ;;>>     modification-tick for a buffer.  One could tell
  238.           ;;>>     whether a buffer had changed by whether the
  239.           ;;>>     modification-tick were different.
  240.           ;;>>     (Presumably there would have to be a way to either
  241.           ;;>>      restore the tick to some previous value, or to
  242.           ;;>>      suspend updating of the tick in order to allow
  243.           ;;>>      things like momentary-string-display)
  244.           (and b
  245.                (save-excursion
  246.              (set-buffer b)
  247.              (set-buffer-modified-p t)))
  248.           (fset 'print-help-return-message 'ignore)
  249.           (call-interactively fun)
  250.           (and (get-buffer name)
  251.                (get-buffer-window (get-buffer name))
  252.                (or (not b)
  253.                (not (eq b (get-buffer name)))
  254.                (not (buffer-modified-p b)))))
  255.           (fset 'print-help-return-message p)
  256.           (and b (buffer-name b)
  257.            (save-excursion
  258.              (set-buffer b)
  259.              (set-buffer-modified-p m))))))
  260.     (with-electric-help 'ignore name t))))
  261.  
  262.  
  263. (defun electric-describe-key ()
  264.   (interactive)
  265.   (electric-helpify 'describe-key))
  266.  
  267. (defun electric-describe-mode ()
  268.   (interactive)
  269.   (electric-helpify 'describe-mode))
  270.  
  271. (defun electric-view-lossage ()
  272.   (interactive)
  273.   (electric-helpify 'view-lossage))
  274.  
  275. ;(defun electric-help-for-help ()
  276. ;  "See help-for-help"
  277. ;  (interactive)
  278. ;  )
  279.  
  280. (defun electric-describe-function ()
  281.   (interactive)
  282.   (electric-helpify 'describe-function))
  283.  
  284. (defun electric-describe-variable ()
  285.   (interactive)
  286.   (electric-helpify 'describe-variable))
  287.  
  288. (defun electric-describe-bindings ()
  289.   (interactive)
  290.   (electric-helpify 'describe-bindings))
  291.  
  292. (defun electric-describe-syntax ()
  293.   (interactive)
  294.   (electric-helpify 'describe-syntax))
  295.  
  296. (defun electric-command-apropos ()
  297.   (interactive)
  298.   (electric-helpify 'command-apropos))
  299.  
  300. ;(define-key help-map "a" 'electric-command-apropos)
  301.  
  302.  
  303.  
  304. ;;;; ehelp-map
  305.  
  306. (defvar ehelp-map ())
  307. (if ehelp-map
  308.     nil
  309.   (let ((map (copy-keymap help-map))) 
  310.     (substitute-key-definition 'describe-key 'electric-describe-key map)
  311.     (substitute-key-definition 'describe-mode 'electric-describe-mode map)
  312.     (substitute-key-definition 'view-lossage 'electric-view-lossage map)
  313.     (substitute-key-definition 'describe-function 'electric-describe-function map)
  314.     (substitute-key-definition 'describe-variable 'electric-describe-variable map)
  315.     (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
  316.     (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
  317.  
  318.     (setq ehelp-map map)
  319.     (fset 'ehelp-command map)))
  320.  
  321. ;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
  322.  
  323. (provide 'ehelp) 
  324.  
  325. ;;; ehelp.el ends here
  326.